Loadstar 41

home *** CD-ROM | disk | FTP | other *** search

/ Loadstar 41 / 041.d81 / snag source (.txt) < prev next >

Wrap

Commodore BASIC | 1987-01-01 | 20.1 KB | 779 lines

1000 sys700:.opt oo 1010 *=$c000 1020 ; 1030 ;******************************** 1040 ;* * 1050 ;* snag 1.0 * 1060 ;* * 1070 ;* copyright 1987 by nick peck * 1080 ;* * 1090 ;******************************** 1100 ; 1110 nmioff =$fec1 ;restore is off here 1120 stuff =$f000 ;mem. for snag stack 1130 string =$ab1e ;display a string 1140 getin =$ffe4 ;get a keyboard byte 1150 chrout =$ffd2 ;output a byte 1160 chrin =$ffcf ;64's input routine 1170 plot =$fff0 ;plot 64's cursor 1180 close =$ffc3 ;close a file 1190 clall =$ffe7 ;close all files 1200 open =$ffc0 ;open a file 1210 setnam =$ffbd ;set file name 1220 setlfs =$ffba ;set file status 1230 talk =$ffb4 ;make device talk 1240 tksa =$ff96 ;talk second address 1250 chkout =$ffc9 ;open output channel 1260 untlk =$ffab ;make device untalk 1270 acptr =$ffa5 ;serial port get 1280 cursco =$0286 ;64's cursor color 1290 scnlin =$0748 ;start of menu 1300 txtlin =$0770 ;start of text line 1310 collin =$db48 ;menu color memory 1320 a =$02 ;temps used everywhere 1330 b =$03 ; '' '' 1340 xtemp =$04 ; '' '' 1350 ytemp =$05 ; '' '' 1360 blockx =$fd ;position of block 1370 blocky =$fe ; '' '' 1380 xpos =$fb ;position of cursor 1390 ypos =$fc ; '' '' 1400 lowpnt =$06 ;low-high used in plot 1410 highpt =$07 ; '' '' 1420 collow =$22 ;used to get old color 1430 colhii =$23 ; '' '' 1440 oldcol =$24 ;flag- use old color 1450 addmov =$25 ;flag- right or down 1460 xptemp =$4b ;temp for make block 1470 yptemp =$4c ; '' '' 1480 xbtemp =$4d ; '' '' 1490 ybtemp =$4e ; '' '' 1500 flpplt =$4f ;flag- plot y,x *(x,y) 1510 output =$50 ;flag- output unblock 1520 lastch =$51 ;temp for unblock 1530 choice =$52 ;append choice (y/n) 1540 curcol =$53 ;current snag color 1550 qtmode =$d4 ;64 quote mode on/off 1560 ; 1570 ;the following code copies the 1580 ;stack and zero page so that snag 1590 ;has it's own stack and zero page 1600 ;when entered via the hardware irq 1610 ; 1620 intstr lda #"n" ;start append 1630 sta choice ;choice as 'n 1640 lda #"/" 1650 sta fname ;start file 1660 lda #"," ;name as '/' 1670 sta fname+1 1680 sei 1690 lda #>rthere ;set return 1700 pha ;address for 1710 lda #<rthere-1 ;flip stack 1720 pha ;routine. 1730 tsx ;save stack 1740 stx stktmp ;pointer 1750 lda #0 1760 sta $fb ;copy first 1770 sta $fc ;4 blocks of 1780 lda #<stuff ;memory 1790 sta $fd 1800 lda #>stuff 1810 sta $fe 1820 ldx #4 1830 ldy #2 1840 mrtoit lda ($fb),y 1850 sta ($fd),y 1860 iny 1870 bne mrtoit 1880 inc $fc 1890 inc $fe 1900 dex 1910 bne mrtoit 1920 lda #<nmioff ;snag vectors 1930 sta $0318 ;snag restore 1940 lda #>nmioff ;is disabled 1950 sta $0319 1960 lda #<extsng ;brk vector 1970 sta $0316 ;is used to 1980 lda #>extsng ;exit snag 1990 sta $0317 2000 lda #>start ;new pch 2010 pha 2020 lda #<start ;new pcl 2030 pha 2040 lda #0 ;status 2050 pha 2060 pha ;.a 2070 pha ;.x 2080 pha ;.y 2090 lda #>rthre2 ;set return 2100 pha ;address for 2110 lda #<rthre2-1 ;next flip 2120 pha ;stack call 2130 jmp flipmm ;flip stacks 2140 rthere lda #<baserr ;change basics 2150 sta $0300 ;error message 2160 lda #>baserr ;vector to 2170 sta $0301 ;reset irq 2180 cli 2190 lda #96 ;put an rts 2200 sta intstr ;in first byte 2210 rts 2220 ; 2230 ;every time basic prints an error 2240 ;or a 'ready' the irq vector is 2250 ;set to snag 2260 ; 2270 baserr sei 2280 ldy #<(NULL)ther ;new irq that 2290 sty $0314 ;looks for a 2300 ldy #>(NULL)ther ;ctrl-f3 2310 sty $0315 2320 cli 2330 jmp $e38b 2340 ; 2350 ;the irq comes here to look for 2360 ;a ctrl-f3 2370 ; 2380 (NULL)ther lda $c5 ;look for f3 2390 cmp #5 2400 beq yesf3 2410 outirq jmp $ea31 2420 yesf3 lda $028d ;look for ctrl 2430 cmp #4 2440 bne outirq 2450 lda #>retext 2460 pha 2470 lda #<retext-1 2480 pha 2490 jmp flipmm ;flip stacks 2500 rthre2 jmp $ea31 2510 ; 2520 extsng lda #>rthre2 2530 pha 2540 lda #<rthre2-1 2550 pha 2560 jmp flipmm ;flip stacks 2570 retext jmp $ea31 2580 ; 2590 ;this routine flips the stack 2600 ;memory with a modified stack 2610 ;in memory without using 2620 ;zero page 2630 ; 2640 flipmm lda #<stuff 2650 sta top+1 ;source low 2660 sta stuff2+1 2670 lda #>stuff 2680 sta top+2 ;source high 2690 sta stuff2+2 2700 lda #0 2710 sta stuff1+1 ;target low 2720 sta stuff3+1 2730 sta stuff1+2 ;target high 2740 sta stuff3+2 2750 ldy #4 2760 ldx #2 2770 toplop lda #52 ;off basic 2780 sta $01 2790 top lda $ffff,x ;source 2800 sta tmpbyt 2810 lda #55 ;on basic 2820 sta $01 2830 stuff1 lda $ffff,x ;target 2840 stuff2 sta $ffff,x ;source 2850 lda tmpbyt 2860 stuff3 sta $ffff,x ;target 2870 inx 2880 bne toplop 2890 inc top+2 2900 inc stuff1+2 2910 inc stuff2+2 2920 inc stuff3+2 2930 dey 2940 bne toplop 2950 lda stktmp ;flip stack 2960 tsx ;pointers 2970 stx stktmp 2980 tax 2990 txs 3000 rts 3010 ; 3020 start ldy #0 ;actual start 3030 sty xpos ;of snag code 3040 lda #216 3050 sta ypos 3060 lda #<color ;make a copy 3070 sta blockx ;of screen 3080 lda #>color ;color 3090 sta blocky 3100 ldx #4 3110 trans lda (xpos),y 3120 sta (blockx),y 3130 iny 3140 bne trans 3150 inc ypos 3160 inc blocky 3170 dex 3180 bne trans ;set snag cur- 3190 lda 53281 ;sor color 3200 and #15 ;according to 3210 tax ;table 3220 lda colors,x 3230 sta curcol 3240 ldx #255 ;disable block 3250 stx blockx ;with two ff's 3260 stx blocky 3270 inx 3280 stx oldcol ;1 = old color 3290 stx addmov ;1 = add x or y 3300 stx flpplt ;1 = y,x not x,y 3310 stx output ;1 = disk/printr 3320 stx xpos ;cursor x and y 3330 stx ypos 3340 txa 3350 tay ;plot initial 3360 jsr revers ;cursor 3370 getmor jsr getin 3380 beq getmor 3390 cmp #"[133]" ;is it an f1 3400 bne nostop 3410 jsr unblck ;yes, shut off 3420 ldx xpos ;block, erase 3430 ldy ypos ;cursor and exit 3440 inc oldcol ;according to 3450 jsr revers ;the brk vector 3460 brk 3470 nop:nop:nop ;pc returns 3480 jmp start ;here 3490 nostop cmp #"" ;cursor right 3500 bne notrit 3510 ldx xpos 3520 cpx #39 3530 beq notrit 3540 inc addmov ;set add flag 3550 jsr xblock ;move right 3560 dec addmov ;unset add flag 3570 notrit cmp #"[157]" ;cursor left 3580 bne notlft 3590 ldx xpos 3600 beq notlft 3610 inc oldcol ;set color flag 3620 jsr xblock ;move left 3630 dec oldcol ;unset col flag 3640 notlft cmp #"" ;cursor down 3650 bne notdwn 3660 ldx ypos 3670 cpx #24 3680 beq notdwn 3690 inc addmov ;set add flag 3700 jsr yblock ;move down 3710 dec addmov ;unset add flag 3720 notdwn cmp #"[145]" ;cursor up 3730 bne notup 3740 ldx ypos 3750 beq notup 3760 inc oldcol ;set color flag 3770 jsr yblock ;move up 3780 dec oldcol ;unset col flag 3790 notup cmp #"[146]" ;reverse off 3800 bne notunb 3810 jsr unblck ;shut off block 3820 notunb cmp #"" ;reverse on 3830 bne nosblk 3840 jsr onblck ;turn on block 3850 nosblk cmp #13 ;a return 3860 bne notret 3870 jmp newmen ;(NULL) to new menu 3880 notret jmp getmor 3890 jmp getmor ;3 extra bytes 3900 rts ;for expansion 3910 ; 3920 newmen jsr plines ;put lines on 3930 newmn2 lda curcol ;set cursor 3940 sta cursco ;color 3950 lda #<menu1 ;display snag 3960 ldy #>menu1 ;menu options 3970 jsr string 3980 getnew jsr getin ;get a key 3990 beq getnew 4000 cmp #"[133]" ;is it an f1 4010 bne notesc ;no, move on 4020 jsr levnew ;yes, return 4030 jmp getmor ;screen and (NULL) 4040 notesc cmp #"p" ;is key printer 4050 bne notpnt ;no, move on 4060 jsr opnpnt ;open printer 4070 lda #13 ;print a cr 4080 jsr chrout 4090 jsr clsfil ;close printer 4100 lda $90 ;is printer on 4110 beq (NULL)ahed ;yes, move on 4120 jmp shoerr ;no, show error 4130 (NULL)ahed jsr opnpnt ;re-open printer 4140 jmp proce2 ;print block 4150 opnpnt ldy #$ff ;default 4160 lda #%00000010 4170 bit 53272 ;check up case 4180 beq upcase 4190 ldy #7 ;no, print lower 4200 upcase lda #32 ;file number 4210 ldx #4 ;device number 4220 jsr setlfs ;set up file #32 4230 lda #0 ;set nill name 4240 jsr setnam 4250 jsr levnew ;erase new menu 4260 jsr open ;open file #32 4270 ldx #32 ;make file #32 4280 jsr chkout ;an output file 4290 rts 4300 notpnt cmp #"f" ;is key a file 4310 bne getnew ;no, (NULL) get key 4320 jsr space ;clear space 4330 lda #<menu2 ;ask for 4340 ldy #>menu2 ;file name 4350 jsr string 4360 ldx #0 4370 mornam lda fname,x ;print last 4380 cmp #"," ;name until a 4390 beq notnam ;comma (,) is 4400 jsr chrout ;hit 4410 inx 4420 bne mornam 4430 notnam ldx #22 ;position 4440 ldy #20 ;cursor at 4450 clc ;start of input 4460 jsr plot 4470 inc qtmode ;quote mode on 4480 ldy #0 4490 readit jsr chrin ;kernal input 4500 cmp #13 4510 beq endinp 4520 sta fname,y ;store input 4530 iny 4540 bne readit 4550 endinp lda #"," ;tack on ,s, 4560 sta fname,y ;leaving the 4570 lda #"s" ;last byte to 4580 sta fname+1,y ;be choosen 4590 lda #"," ;later 4600 sta fname+2,y 4610 sty a 4620 jsr space 4630 lda #<menu3 ;ask for an 4640 ldy #>menu3 ;append 4650 jsr string 4660 lda choice ;print last 4670 jsr chrout ;choice (y = 4680 lda #"[157]" ;append, n = 4690 jsr chrout ;write) 4700 inc qtmode ;quote mode on 4710 jsr chrin ;kernal input 4720 tay 4730 sty choice ;save response 4740 untend jsr chrin ;empty input 4750 cmp #13 ;buffer 4760 bne untend 4770 ldx choice 4780 lda #"w" ;n = w(rite) 4790 ldy a 4800 cpx #"y" 4810 bne notapn 4820 lda #"a" ;y = a(ppend) 4830 notapn sta fname+3,y 4840 tya 4850 clc ;adjust length 4860 adc #4 ;of file name 4870 ldx #<fname 4880 ldy #>fname 4890 jsr setnam ;kernal setnam 4900 lda #32 4910 ldx #8 4920 ldy #2 4930 jsr setlfs 4940 jsr levnew ;erase new menu 4950 lda #8 4960 ldx #0 4970 stx $90 4980 jsr talk ;make disk talk 4990 jsr untlk ;to see if it 5000 ldx $90 ;is turned on 5010 beq nodker ;on, move on 5020 jmp shoerr ;off,show error 5030 nodker jsr open 5040 lda #8 ;check for a 5050 sta $ba ;disk error 5060 jsr talk ;after opening 5070 lda #$6f 5080 jsr tksa 5090 ldy #0 5100 morerr jsr acptr 5110 sta errbuf,y ;save disk 5120 iny ;message 5130 cmp #13 5140 bne morerr 5150 jsr untlk 5160 lda #0 5170 sta errbuf,y ;end with 0 5180 lda errbuf ;was there an 5190 cmp #"0" ;error 5200 beq proced 5210 jsr plines ;yes, display 5220 lda #<mesbuf ;disk error 5230 ldy #>mesbuf ;message 5240 jsr string 5250 jsr clsfil ;close file 5260 jmp waitit ;exit new menu 5270 proced ldx #32 5280 jsr chkout 5290 ; 5300 ;the printer also uses the 5310 ;following code to output its 5320 ;block 5330 ; 5340 proce2 inc output ;set output flag 5350 jsr unblck ;output block 5360 dec output ;unset output. 5370 lda $ba ;check device 5380 cmp #4 ;printer 5390 bne noprnt ;no, move on 5400 lda #13 ;yes, do a cr 5410 jsr chrout 5420 noprnt jsr clsfil ;close file 5430 jmp getmor ;(NULL) to main menu 5440 ; 5450 clsfil lda #32 ;close file #32 5460 jsr close 5470 jmp clall 5480 ; 5490 shoerr jsr plines ;put lines on 5500 ldx #22 5510 ldy #8 5520 clc 5530 jsr plot 5540 lda #<menu4 ;print output 5550 ldy #>menu4 ;device is off 5560 jsr string 5570 waitit jsr getin ;wait for a key 5580 beq waitit 5590 jsr space ;erase lines 5600 jmp newmn2 ;output menu 5610 ; 5620 levnew ldx #119 ;put old screen 5630 lines2 lda menu,x ;back 5640 sta scnlin,x 5650 lda menu+120,x 5660 sta collin,x 5670 dex 5680 bpl lines2 5690 rts 5700 ; 5710 plines ldx #119 5720 lines lda scnlin,x ;save three 5730 sta menu,x ;lines of the 5740 lda collin,x ;screen in mem 5750 sta menu+120,x 5760 lda #64 ;use a line 5770 sta scnlin,x 5780 lda curcol ;get color 5790 sta collin,x 5800 dex 5810 bpl lines 5820 space ldx #39 ;clear the line 5830 lda #32 ;used for text 5840 zapscn sta txtlin,x 5850 dex 5860 bpl zapscn 5870 ldx #22 5880 ldy #0 ;position 5890 clc ;cursor and 5900 jmp plot ;return 5910 ; 5920 ;converts x , y into low , high 5930 ; 5940 makexy lda flpplt ;is plot normal 5950 beq normal 5960 stx ytemp ;flipped y,x 5970 sty xtemp 5980 jmp theplt 5990 normal stx xtemp ;normal x,y 6000 sty ytemp 6010 theplt lda #4 ;screen high 6020 sta highpt 6030 lda #>color ;saved color 6040 sta colhii ;high byte 6050 lda #0 ;start mult at 0 6060 ldx ytemp ;mult .x times 6070 beq nomult 6080 mormlt clc 6090 adc #40 ;mult. by 40 6100 bcc nobrk ;y position 6110 inc highpt 6120 inc colhii 6130 nobrk dex 6140 bne mormlt 6150 nomult clc 6160 adc xtemp ;add how many 6170 bcc notbrk ;over 6180 inc highpt 6190 inc colhii 6200 notbrk sta lowpnt 6210 rts 6220 ; 6230 revers jsr makexy 6240 ldy #0 6250 lda (lowpnt),y ;get charac. 6260 eor #128 ;invert character 6270 sta lastch ;save character 6280 sta (lowpnt),y ;put charac. 6290 lda highpt 6300 and #$03 ;prepare high 6310 ora #$d8 ;byte for color 6320 sta highpt 6330 lda #<color ;set low byte 6340 clc ;for original 6350 adc lowpnt ;screen color 6360 bcc nocobk ;saved in mem 6370 inc colhii 6380 nocobk sta collow 6390 lda curcol ;get current col 6400 ldx oldcol ;use old color 6410 beq strcol ;no, move on 6420 lda (collow),y ;yes, get it 6430 strcol sta (lowpnt),y ;store color 6440 rts 6450 ; 6460 plotxy ldx xptemp 6470 ldy yptemp 6480 jmp revers 6490 ; 6500 cursor lda oldcol ;save color flag 6510 pha 6520 lda #0 6530 sta oldcol ;plot snag cursr 6540 jsr plotxy 6550 pla ;reset color 6560 sta oldcol ;flag 6570 rts 6580 ; 6590 ascii cmp #$20 ;from memory 6600 bcs one ;to ascii 6610 three clc 6620 adc #$40 6630 rts 6640 one cmp #$40 6650 bcs two 6660 rts 6670 two cmp #$60 6680 bcs three 6690 clc 6700 adc #$20 6710 rts 6720 ; 6730 ;the following code either plots a 6740 ;a single reversed space or 6750 ;reverses a line if the block is 6760 ;turned on 6770 ; 6780 (NULL)scrn lda xptemp 6790 cmp xbtemp 6800 bmi oneblk 6810 lda yptemp 6820 cmp ybtemp 6830 bcs xxblck 6840 oneblk inc oldcol 6850 jsr plotxy 6860 dec oldcol 6870 lda addmov 6880 beq subit 6890 inc xptemp ;increment x pos 6900 lda xptemp ;is x on block 6910 cmp xbtemp 6920 bne outhre 6930 dec xptemp 6940 lda yptemp ;yes, but be 6950 cmp ybtemp ;sure y pos is 6960 bcs xxblck ;on block too 6970 inc xptemp 6980 bne outhre 6990 subit dec xptemp 7000 outhre jmp cursor 7010 xxblck lda addmov ;is it an add 7020 beq notadd ;0 = sub 7030 inc xptemp ;otherwise add 7040 notadd inc yptemp 7050 lda xptemp 7060 sta a 7070 lda ybtemp 7080 sta b 7090 morlin ldx a 7100 ldy b 7110 jsr revers 7120 inc b 7130 lda b 7140 cmp yptemp 7150 bne morlin 7160 dec yptemp 7170 lda addmov ;was it a sub 7180 bne noaddd ;1 = add 7190 lda xptemp 7200 cmp xbtemp 7210 bne nottnd 7220 dec xptemp 7230 jmp cursor 7240 nottnd dec xptemp ;otherwise sub 7250 noaddd rts 7260 ; 7270 xblock lda xpos ;prepare temps 7280 sta xptemp ;for a right or 7290 lda ypos ;left block move 7300 sta yptemp 7310 lda blockx 7320 sta xbtemp 7330 lda blocky 7340 sta ybtemp 7350 jsr (NULL)scrn ;do the move 7360 lda xptemp ;get changed 7370 sta xpos ;position values 7380 lda yptemp 7390 sta ypos 7400 lda #0 7410 rts 7420 ; 7430 yblock inc flpplt ;prepare temps 7440 lda xpos ;for an up or 7450 sta yptemp ;down block move 7460 lda ypos 7470 sta xptemp 7480 lda blockx 7490 sta ybtemp 7500 lda blocky 7510 sta xbtemp 7520 jsr (NULL)scrn ;do the move 7530 lda xptemp ;get changed 7540 sta ypos ;position values 7550 lda yptemp 7560 sta xpos 7570 lda #0 7580 sta flpplt 7590 rts 7600 ; 7610 unblck lda xpos ;is xpos inside 7620 cmp blockx ;of block 7630 bmi noblck ;no, leave here 7640 lda ypos ;is ypos inside 7650 cmp blocky ;of block 7660 bmi noblck ;no, leave here 7670 lda blocky 7680 cmp #$ff ;is block off 7690 beq noblck ;yes, leave here 7700 sta yptemp 7710 inc oldcol ;reset old color 7720 ; 7730 ;this next part finds the end of 7740 ;each block line so no spaces are 7750 ;considered as output. the next 7760 ;section then un-does the block 7770 ;and outputs data if the output 7780 ;flag is non-zero. 7790 ; 7800 reduce lda xpos 7810 sta a 7820 lda blockx 7830 sta xptemp 7840 lda yptemp 7850 sta b 7860 morred jsr getxy 7870 cmp #160 ;is it a space 7880 bne morex ;no, end found 7890 ldx a ;yes, un-do it 7900 ldy b 7910 jsr revers ;unreverse space 7920 lda a ;has a line been 7930 cmp blockx ;reduced 7940 beq yesx ;yes, leave here 7950 dec a ;no, move left 7960 jmp morred ;to next column 7970 ; 7980 morex jsr plotxy ;inverse char 7990 lda output ;disk or printer 8000 beq notout ;no, skip output 8010 lda lastch ;get character 8020 cmp #127 8030 bcc oksize 8040 eor #$80 8050 oksize jsr ascii ;poke to ascii 8060 jsr chrout ;output it 8070 notout lda xptemp 8080 cmp a ;is row erased 8090 beq yesx 8100 inc xptemp ;no, add column 8110 bne morex ;and (NULL) back 8120 yesx lda yptemp 8130 cmp ypos ;are rows done 8140 beq yesy 8150 lda output 8160 beq nocr 8170 lda #13 ;output endoflne 8180 jsr chrout 8190 nocr inc yptemp ;no, add row 8200 bne reduce ;and (NULL) back 8210 yesy dec oldcol ;off color flag 8220 lda output ;one more cr 8230 beq noway 8240 lda #13 8250 jsr chrout 8260 noway lda xpos 8270 sta xptemp 8280 jsr plotxy ;turn on cursor 8290 noblck lda #$ff 8300 sta blockx ;turn off block 8310 sta blocky ;with two $ff's 8320 rts 8330 ; 8340 getxy ldx a 8350 ldy b 8360 jsr makexy 8370 ldy #0 8380 lda (lowpnt),y 8390 rts 8400 ; 8410 onblck jsr unblck ;un do block 8420 lda xpos ;start block at 8430 sta blockx ;cursor x and y 8440 lda ypos 8450 sta blocky 8460 lda #0 8470 rts 8480 ; 8490 menu1 .asc " (f) file " 8500 .asc " (p) printer " 8510 .asc " (f1) exit" 8520 .byt 0 8530 menu2 .asc " enter" 8540 .asc " file name: " 8550 .byt 0 8560 menu3 .asc " append to this" 8570 .asc " existing file" 8580 .asc " (y/n)? " 8590 .byt 0 8600 menu4 .asc "output device not " 8610 .asc "present" 8620 .byt 0 8630 colors .byt 5,14,15,6,6,0,15,5 8640 .byt 0,3,6,14,2,6,11,10 8650 mesbuf .asc " disk: " 8660 errbuf = * 8670 *=* + 40 8680 color = * 8690 *=* + 1024 8700 menu = * 8710 *=* + 240 8720 fname = * 8730 *=* + 20 8740 stktmp = * 8750 *=*+1 8760 tmpbyt = * 8770 *=*+1